home *** CD-ROM | disk | FTP | other *** search
/ ShareWare OnLine 2 / ShareWare OnLine Volume 2 (CMS Software)(1993).iso / cad / mar93cad.zip / TIP849.LSP < prev    next >
Lisp/Scheme  |  1993-02-13  |  11KB  |  227 lines
  1. ; TIP 849: 3DPP.LSP (c)1993, John R. Ricker
  2. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  3. ;;                     ========== 3DPP.LSP ==========
  4. ;;                         [3][D] [P]oint [P]lot
  5. ;;
  6. ;;  This progrm will read in almost ANY ASCII data file that contains at
  7. ;;  least the 4 following data fields:
  8. ;;
  9. ;;    Easting (x), Northing (y), Elevation (z) and a Point Name
  10. ;;
  11. ;;    3d Point Plot Example Data File
  12. ;;    Field Lengths
  13. ;;    12345678901234567890123456789012345678901234567890
  14. ;;
  15. ;;    500 1025563.846 586617.565 1650.418 Geo Joint
  16. ;;    501 1025564.112 586612.663 1650.444 Geo Joint
  17. ;;    502 1025566.532 586607.713 1650.735 Geo Joint
  18. ;;    ¿ <-------------( Break between lines = ASCII Code 168 )
  19. ;;    503 1025568.910 586604.281 1651.010 Geo Joint
  20. ;;    504 1025570.835 586602.764 1651.158 Geo Joint
  21. ;;    505 1025568.102 586606.667 1650.967 Geo Joint
  22. ;;    506 1025565.178 586611.950 1650.599 Geo Joint
  23. ;;    <EOF> <-------------------------------------- (Carriage Return)
  24. ;;
  25. ;;;;;;;;;;;;;;;;;;;;; < Sample Prompts and Answers > ;;;;;;;;;;;;;;;;;;;;;;;;;
  26. ;;
  27. ;;     Enter the Number of Title Lines before data points...? : 4
  28. ;;     Enter the STARTING COLUMN for points NAME............? : 1
  29. ;;     Enter the FIELD LENGTH for the NAME..................? : 3
  30. ;;     Enter the Starting Column for points NORTHING..[ Y ] ? : 5
  31. ;;     Enter the FIELD LENGTH for the NORTHING..............? : 11
  32. ;;     Enter the Starting Column for points EASTING...[ X ] ? : 17
  33. ;;     Enter the FIELD LENGTH for the EASTING...............? : 10
  34. ;;     Enter the Starting Column for points ELEVATION.[ Z ] ? : 28
  35. ;;     Enter the FIELD LENGTH for the ELEVATION.............? : 8
  36. ;;
  37. ;;     Enter INPUT File to plot WITH EXTension..............? : TEST.DAT
  38. ;;
  39. ;;     Connect 3-D Points with 3-D Polylines < Y >..........? : Y
  40. ;;
  41. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  42. ;;  Written by: John R. Ricker Jr.
  43. ;;              R I C K E R  Computing
  44. ;;              1345 E. Mercer Lane
  45. ;;              Phoenix, Arizona 85020
  46. ;;              (602) 997-2948
  47. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  48. (defun C:3DPP (/ FIL EOF OLDLYR OLDPD COUNT RFIL$ XYZ NORTH EAST ELEV NAME
  49.                  PT1 PT2 DATA TITL_LI N_L N_S E_L E_S NAME_L NAME_S ELEV_L
  50.                  ELEV_S BLNK_LI DL)
  51.  
  52.    (setvar "BLIPMODE" 0)                           ; Turn off Blipmode
  53.    (setvar "CMDECHO" 0)                            ; Turn off Command Echo
  54. ;;
  55. ;; Get the Scale Factor 
  56. ;;
  57.    (setq SF 
  58.      (getreal 
  59.        "\nPlease Enter a Scale factor.....................< 1.0 > ? : ")
  60.    )                                               ; end setq
  61.    (if (or (= SF "")(= SF nil))(setq SF 1.0))      ; set scale to 1 if nil 
  62. ;;
  63. ;; Get the needed information from the data file to be processed
  64. ;;
  65.    (princ "\nThe  following information is to DEFINE the FIELDS")
  66.    (princ "\n     of your DATA FILE that you will be using")
  67.    (setq TITL_LI
  68.      (getint "\nEnter the Number of Title Lines before data points...? : ")
  69.          NAME_S
  70.      (getint "\nEnter the STARTING COLUMN for points NAME............? : ")
  71.          NAME_L
  72.      (getint "\nEnter the FIELD LENGTH for the NAME..................? : ")
  73.          N_S
  74.      (getint "\nEnter the Starting Column for points NORTHING..[ Y ] ? : ")
  75.          N_L
  76.      (getint "\nEnter the FIELD LENGTH for the NORTHING..............? : ")
  77.          E_S
  78.      (getint "\nEnter the Starting Column for points EASTING...[ X ] ? : ")
  79.          E_L
  80.      (getint "\nEnter the FIELD LENGTH for the EASTING...............? : ")
  81.          ELEV_S
  82.      (getint "\nEnter the Starting Column for points ELEVATION.[ Z ] ? : ")
  83.          ELEV_L
  84.      (getint "\nEnter the FIELD LENGTH for the ELEVATION.............? : ")
  85.          RFIL$
  86.      (getstring "\nEnter INPUT File to plot WITH EXTension..............? : ")
  87.          DL
  88.      (getstring "\nConnect 3-D Points with 3-D Polylines < Y >..........? : ")
  89.    )                                               ; end setq
  90.    (if (or (= DL "")(= DL nil)(= DL "YES")
  91.            (= DL "Y")(= DL "yes")(= DL "y")
  92.        )                                           ; end or
  93.        (setq DL "YES")                             ; if DL is nil set to Yes
  94.    )                                               ; end if
  95.    (setq FIL (open RFIL$ "r")                      ; open file to read
  96.          EOF "NO"                                  ; set end of file to no
  97.          OLDLYR (getvar "CLAYER")                  ; save old layer
  98.          OLDPD (getvar "PDMODE")                   ; save Pdmode
  99.          COUNT 0                                   ; set counter to 0
  100.          XYZ (if XYZ XYZ 4)                        ; needed for spin wheel
  101.          BLNK_LI 1                                 ; set blank line to 1
  102.    )                                               ; end setq
  103.    (setvar "PDMODE" 0)                             ; set pdmode 
  104. ;;
  105. ;; Create the needed layers
  106. ;;
  107.    (command "LAYER" "M" "3D_TXT" "C" "Magenta" ""  
  108.                     "M" "3D_PTS" "C" "CYAN"    ""
  109.                     "M" "3D_PL"  "C" "Yellow"  ""
  110.                     "S" "0" ""
  111.    )                                               ; end command 
  112. ;;
  113. ;; Read in the blank lines at the beginning of the data file
  114. ;;
  115.    (if (/= TITL_LI 0)
  116.      (repeat TITL_LI (read-line FIL))
  117.    )                                               ; end if
  118. ;;
  119. ;; read in first line of data
  120. ;;
  121.    (setq DATA (read-line FIL))               
  122. ;;
  123. ;; Statement to print 
  124. ;;
  125.    (if (= DL "YES")
  126.      (princ "\nPlotting and Connecting 3-D Points and 3-D Polyline......  ")
  127.      (princ "\nPlotting 3-D points..........................  ")   ; else
  128.    )                                               ; end if
  129. ;;
  130. ;; Enter while loop to start processing point
  131. ;;
  132.    (while (= EOF "NO")  
  133.      (setq COUNT (+ COUNT 1))                      ; Increment counter
  134. ;;
  135. ;; Spin function to show the user that something is going on
  136. ;;
  137.      (princ
  138.        (cond ((= (rem (setq XYZ (1+ XYZ)) 4) 0) "\010|")
  139.              ((= (rem XYZ 4) 1) "\010/")
  140.              ((= (rem XYZ 4) 2) "\010-")
  141.              (t "\010\\")
  142.        )                                           ; end condition
  143.      )                                             ; end princ
  144.      (if (= DATA nil)
  145.        (setq EOF "YES")                            ; if data is nil 
  146.        (progn
  147.          (setq NORTH   (atof (substr DATA N_S N_L))       ; get y value
  148.                EAST    (atof (substr DATA E_S E_L))       ; get x value
  149.                ELEV    (atof (substr DATA ELEV_S ELEV_L)) ; get z value
  150.                NAME    (substr DATA NAME_S NAME_L)        ; get pt name
  151.                PT1     (list EAST NORTH ELEV)             ; x y z value
  152.          )                                                ; end setq  
  153.          (if (or (/= NORTH 0.0)(/= NORTH nil)(/= NORTH ""))
  154.            (progn
  155.              (command "LAYER" "SET" "3D_PTS" "")   ; set layer to 3d_pts
  156.              (command "POINT" PT1)                 ; draw point
  157.            )                                       ; end progn
  158.          )                                         ; end if
  159.          (if (or (= NORTH 0.0)(= EAST 0.0))
  160.            (command "ERASE" "L" "" "")             ; erase invalid point
  161.          )
  162.          (if (or (/= NORTH nil)(/= NORTH ""))
  163.            (progn
  164.              (command "LAYER" "S" "3D_TXT" "")     ; set layer to 3d_txt
  165.              (command "TEXT" "C" PT1 (* 0.08 SF) "" NAME) ; draw text
  166.            )                                       ; end progn
  167.          )                                         ; end if
  168. ;;
  169. ;; if draw 3d polylines is tes
  170. ;;
  171.          (if (= DL "YES")
  172.            (if (> COUNT BLNK_LI)                   ; do if count is greater
  173.                                                    ; then Blnk_ln
  174.              (progn
  175.                (if (or (= NORTH 0.0)
  176.                        (= EAST 0.0)
  177.                    )                               ; end or
  178.                    (setq PT1 PT2)                  
  179.                )                                   ; end if
  180.                (command "LAYER" "SET" "3D_PL" "")  ; set layer to 3d_pl
  181.                (command "3DPOLY" PT1 PT2 "")       ; draw 3d_poly
  182.                (setq PT2 PT1)                      ; set second point to be
  183.                                                    ; the first point
  184.              )                                     ; end progn
  185.              (setq PT2 PT1)                        ; set second point to be
  186.                                                    ; first point
  187.            )                                       ; end if 2
  188.          )                                         ; end if 1
  189.          (setq DATA (read-line FIL))               ; read next line of data
  190.          (if (= DATA "¿")                          ; if data is <Alt-168>
  191.                                                    ;   start next line
  192.                                                    ; space, between 3d
  193.                                                    ; polylines
  194.            (setq COUNT 0                           ; set count to 0
  195.                  DATA (read-line FIL)              ; read next line of data
  196.            )                                       ; end setq
  197.          )                                         ; end if
  198.        )                                           ; end progn
  199.      )                                             ; end IF
  200.    )                                               ; end while
  201.    (close FIL)                                     ; CLOSE FILE
  202.    (command "LAYER" "S" OLDLYR "F" "3D_TXT" "")    ; restore to original
  203.                                                    ; layer and freeze the
  204.                                                    ; 3d_txt layer
  205. ;; 
  206. ;; erase any points that might be stray around 0,0,0
  207. ;;
  208.    (command "ERASE" "W" "-1.0,-1.0,-1.0" "1.0,1.0,1.0" "")
  209.    (command "ZOOM" "E")                            ; zoom to extense
  210. ;;
  211. ;; See if user wants to view in viewpoint
  212. ;;
  213.    (setq DVP          
  214.      (strcase
  215.        (getstring "\nDo a ViewPoint on the drawing <N> : ? ")
  216.      )                                             ; end strcase
  217.    )                                               ; end setq
  218.    (if (or (= DVP "Y")(= DVP "YES"))(command "VPOINT" ""))
  219. ;;
  220. ;; Exiting message
  221. ;;
  222.    (princ "\nFinished processing points..... Thank you..")
  223.    (princ)
  224. )                                                  ; end defun 3DPP
  225.         
  226.         
  227.